home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / PINBSRC.ZIP / _LOADPRC.PAS < prev    next >
Pascal/Delphi Source File  |  1996-02-02  |  6KB  |  234 lines
  1. {---------------------------------------------------------------------------}
  2. procedure init_colors;
  3. var x:byte;
  4.     f:file;
  5.     reihe:array[1..3] of byte;
  6. begin
  7.   assign(f,'tisch'+tnr+'\t'+tnr+'-pal.pal');
  8.   {$I-}
  9.   reset(f,1);
  10.   {$I+}
  11.   for x:=0 to 255 do
  12.   begin
  13.     blockread(f,reihe,sizeof(reihe));
  14.     pal[x].r := reihe[1];
  15.     pal[x].g := reihe[2];
  16.     pal[x].b := reihe[3];
  17.   end;
  18.   close(f);
  19.   set_rgb_color(led_color_1,20,0,0);
  20.   pal[led_color_1].r := 20;
  21.   pal[led_color_1].g := 0;
  22.   pal[led_color_1].b := 0;
  23.   set_rgb_color(led_color_2,255,0,0);
  24.   pal[led_color_2].r := 255;
  25.   pal[led_color_2].g := 0;
  26.   pal[led_color_2].b := 0;
  27.  
  28.   if tnr='1' then begin
  29.     set_rgb_color($10,33,33,33);
  30.     pal[$10].r := 33; pal[$10].g := 33; pal[$10].b := 33;
  31.     set_rgb_color($11,35,35,35);
  32.     pal[$11].r := 35; pal[$11].g := 35; pal[$11].b := 35;
  33.     set_rgb_color($12,37,37,37);
  34.     pal[$12].r := 37; pal[$12].g := 37; pal[$12].b := 37;
  35.     set_rgb_color($13,39,39,39);
  36.     pal[$13].r := 39; pal[$13].g := 39; pal[$13].b := 39;
  37.     set_rgb_color($14,42,42,42);
  38.     pal[$14].r := 42; pal[$14].g := 42; pal[$14].b := 42;
  39.     set_rgb_color($15,52,52,52);
  40.     pal[$15].r := 52; pal[$15].g := 52; pal[$15].b := 52;
  41.     set_rgb_color($19,33,33,33);
  42.     pal[$19].r := 33; pal[$19].g := 33; pal[$19].b := 33;
  43.   end;
  44.  
  45.    if tnr='2' then begin
  46.     set_rgb_color(170,33,33,33);
  47.     pal[170].r := 33; pal[170].g := 33; pal[170].b := 33;
  48.     set_rgb_color(171,35,35,35);
  49.     pal[171].r := 35; pal[171].g := 35; pal[171].b := 35;
  50.     set_rgb_color(172,37,37,37);
  51.     pal[172].r := 37; pal[172].g := 37; pal[172].b := 37;
  52.     set_rgb_color(173,39,39,39);
  53.     pal[173].r := 39; pal[173].g := 39; pal[173].b := 39;
  54.     set_rgb_color(174,42,42,42);
  55.     pal[174].r := 42; pal[174].g := 42; pal[174].b := 42;
  56.     set_rgb_color(175,52,52,52);
  57.     pal[175].r := 52; pal[175].g := 52; pal[175].b := 52;
  58.     set_rgb_color(176,33,33,33);
  59.     pal[176].r := 33; pal[176].g := 33; pal[176].b := 33;
  60.   end;
  61.  
  62.   for x := 255 downto 0 do set_rgb_color(x,pal[x].r,pal[x].g,pal[x].b);
  63. end;
  64.  
  65. procedure load_table_tab;
  66. var f:file;
  67.     x,y:integer;
  68.     reihe:array[0..319] of byte;
  69.     t : byte;
  70. begin
  71.   for t := 0 to 255 do set_rgb_color(t,0,0,0);
  72.   assign(f,'tisch'+tnr+'\t'+tnr+'-tab.org'{clb});
  73.   reset(f,1);
  74.   y:=48;
  75.   repeat
  76.     blockread(f,reihe,sizeof(reihe));
  77.     for x:= 0 to 319 do put_pixel(x,y,reihe[x]);
  78.     inc(y);
  79.   until y >= 600+48;
  80.   close(f);
  81. end;
  82.  
  83. procedure load_table_gro;
  84. var f:file;
  85.     x,y:word;
  86.     reihe : array[0..319] of byte;
  87.  
  88. begin
  89.   assign(f,'tisch'+tnr+'\t'+tnr+'-gro.clb');
  90.   reset(f,1);
  91.   for y:=0 to 199 do begin
  92.       blockread(f,reihe,sizeof(reihe));
  93.       for x:=0 to 319 do tableground1^[x,y]:=reihe[x];
  94.     end;
  95.  
  96.   for y:=200 to 399 do begin
  97.       blockread(f,reihe,sizeof(reihe));
  98.       for x:=0 to 319 do tableground2^[x,y]:=reihe[x];
  99.     end;
  100.  
  101.   for y:=400 to 599 do begin
  102.       blockread(f,reihe,sizeof(reihe));
  103.       for x:=0 to 319 do tableground3^[x,y]:=reihe[x];
  104.     end;
  105.   close(f);
  106.  
  107. end;
  108.  
  109. procedure load_arm_links;
  110. var f:file;
  111.     x,y:integer;
  112. begin
  113.   assign(f,'gfx\arml1.gfx');
  114.   reset(f,1);
  115.   blockread(f,arm_links^,ArmBreiteLinks*ArmHoeheLinks*5);
  116.   close(f);
  117.  
  118.   if tnr='1' then begin
  119.     for x := 1 to 15360 do
  120.       case arm_links^[x] of
  121.       $00 : arm_links^[x] := 234{30};
  122.       $05 : arm_links^[x] := 31;
  123.       $13 : arm_links^[x] := 32;
  124.       $FF : arm_links^[x] := 33;
  125.     end;
  126.   end;
  127.   if tnr='2' then begin
  128.     for x := 1 to 15360 do
  129.       case arm_links^[x] of
  130.       $00 : arm_links^[x] := 00;
  131.       $05 : arm_links^[x] := 00;
  132.       $13 : arm_links^[x] := 12;
  133.       $FF : arm_links^[x] := 11;
  134.     end;
  135.   end;
  136. end;
  137.  
  138. procedure load_arm_rechts;
  139. var f:file;
  140.     x,y:integer;
  141. begin
  142.   assign(f,'gfx\armr1.gfx');
  143.   reset(f,1);
  144.   blockread(f,arm_rechts^,ArmBreiteRechts*ArmHoeheRechts*5);
  145.   close(f);
  146.  
  147.   if tnr='1' then begin
  148.     for x := 1 to 15360 do
  149.       case arm_rechts^[x] of
  150.       $00 : arm_rechts^[x] := 234{30};
  151.       $05 : arm_rechts^[x] := 31;
  152.       $13 : arm_rechts^[x] := 32;
  153.       $FF : arm_rechts^[x] := 33;
  154.     end;
  155.   end;
  156.   if tnr='2' then begin
  157.     for x := 1 to 15360 do
  158.       case arm_rechts^[x] of
  159.       $00 : arm_rechts^[x] := 00;
  160.       $05 : arm_rechts^[x] := 00;
  161.       $13 : arm_rechts^[x] := 12;
  162.       $FF : arm_rechts^[x] := 11;
  163.     end;
  164.   end;
  165. end;
  166.  
  167.  
  168. procedure load_arm_links_msk;
  169. var f:file;
  170.     x,y:integer;
  171. begin
  172.   assign(f,'msk\arml1.msk');
  173.   reset(f,1);
  174.   blockread(f,arm_links_msk^,ArmBreiteLinks*ArmHoeheLinks*5);
  175.   close(f);
  176. end;
  177.  
  178. procedure load_arm_rechts_msk;
  179. var f:file;
  180.     x,y:integer;
  181. begin
  182.   assign(f,'msk\armr1.msk');
  183.   reset(f,1);
  184.   blockread(f,arm_rechts_msk^,ArmBreiteRechts*ArmHoeheRechts*5);
  185.   close(f);
  186. end;
  187.  
  188.  
  189. procedure load_ball;
  190. var f:file;
  191.     x,y:integer;
  192. begin
  193.   assign(f,'gfx\ball'+tnr+'.gfx');
  194.   reset(f,1);
  195.   blockread(f,ball^,256);
  196.   close(f);
  197. end;
  198.  
  199. procedure load_feder;
  200. var f:file;
  201. begin
  202.   assign(f,'gfx\feder'+tnr+'.gfx');
  203.   reset(f,1);
  204.   blockread(f,feder^,filesize(f));
  205.   close(f);
  206. end;
  207.  
  208. procedure load_mini_palette(fname:string);
  209. var palfile:file of byte;
  210.     j:integer;
  211.     mfm:word;
  212.     colnr:byte;
  213. begin
  214.   mfm:=filemode;
  215.   filemode:=0;
  216.   if Pos('.',fname)=0 then fname:=fname+'.mpa';
  217.   assign(palfile,fname);
  218.   {$I-}
  219.   reset(palfile);
  220.   {$I+}
  221.   if IOresult<>0 then sound(1000);
  222.   repeat
  223.     if not eof(palfile) then read(palfile,colnr);
  224.     if not eof(palfile) then read(palfile,pal[colnr].r);
  225.     if not eof(palfile) then read(palfile,pal[colnr].g);
  226.     if not eof(palfile) then read(palfile,pal[colnr].b);
  227.     set_rgb_color(colnr,pal[colnr].r,pal[colnr].g,pal[colnr].b);
  228.   until eof(palfile);
  229.   close(palfile);
  230.   filemode:=mfm;
  231. end;
  232.  
  233. {---------------------------------------------------------------------------}
  234.